Optional tilemap-display.f

{
TO DO:
  Need to code backup plan for when there's no VBO support.

Tiles are grabbed from the current texture which is treated as a 2048x2048 "texturebank",
containing 64 256x256 "sections".

You can theoretically use any size tiles because the texture coordinates are generated on-the-fly.
But right now, it's hard-wired to do tiles that are 8x8 and fit in a 256-pixel-wide space (32 logical tile units)
This could be changed into a table lookup based on the tileset, or better, a callback.


The maximum width in tiles that can be displayed is 129 tiles. (1 extra for scrolling a 128-wide screen)  This does not limit the size of the map,
just the ammount that can be displayed horizontally.  It's changable...

The tile entries follow this 16-bit format:
  VH?TTTTTTTTTTTTT
  where bits 0-12 (T) are the tile index (0-8191) - 8192 is a conventional limit that accomodates all the 8-bit tiles that fit in a 256x2048 space.
  and VH allow tiles to be flipped vertically and/or horizontally.
  ? is reserved.  could be potentially used in a RLE scheme, but right now I won't be using that.

map arrays are stored in rows

}

Requires OpenGL
Requires Seki
Requires OpenGL\ARB-VBO
Requires GL-Tools
Requires Vectors
Requires SORA\Texturebanks
Requires SORA\Drawing

Requires A
Requires Tools

Only Forth Definitions


\ version using SHORT's
-? : quad!a+' ( x y -- )
  over w!a+ dup w!a+
  over 1+ w!a+ dup w!a+
  over 1+ w!a+ dup 1+ w!a+
  swap w!a+ 1+ w!a+
  ;


: tc!a+   swap w!a+ w!a+ ;

\ generate texture coords for a tile in a texture bank section.
: tlocate ( tile -- x y )
  dup %11111 and swap %1111111111100000 and 5 rshift ;

\ implement the 4 tile flipping styles
: tiletex ( tile  -- )
  tlocate 2dup tc!a+ 2dup 1 0 2+ tc!a+ 2dup 1 1 2+ tc!a+ 1 + tc!a+ ;

: tiletex-h (  tile -- )
  tlocate 2dup 1 0 2+ tc!a+ 2dup tc!a+ 2dup 1 + tc!a+ 1 1 2+ tc!a+ ;

: tiletex-v (  tile -- )
  tlocate 2dup 1 + tc!a+ 2dup 1 1 2+ tc!a+ 2dup 1 0 2+ tc!a+ tc!a+ ;

: tiletex-hv (  tile -- )
  tlocate 2dup 1 1 2+ tc!a+ 2dup 1 + tc!a+ 2dup tc!a+ 1 0 2+ tc!a+ ;

create tile-routines   ' tiletex >code , ' tiletex-h >code , ' tiletex-v >code , ' tiletex-hv >code ,

: parse-tile ( val -- )
  dup 14 rshift cells tile-routines + @ call ;

\ create tile-verts 8 cells 129 * /allot
create tile-tcoords 8 cells 140 * /allot  \ has a bit of safe zone

0 value tile-verts
\ 0 value tile-tcoords

variable vbo
variable vbo-t

: init-tilemap-display
  glGenBuffersARB( 1 vbo )
  vbo @ bind-vbo
  glBufferDataARB( GL_ARRAY_BUFFER_ARB  8 cells 129 *   0 GL_STATIC_DRAW_ARB )
  glMapBufferARB( GL_ARRAY_BUFFER_ARB GL_WRITE_ONLY_ARB ) to tile-verts

  tile-verts a!
  129 0  do    i 0 quad!a+'    1 +loop
  begin glUnmapBufferARB( GL_ARRAY_BUFFER_ARB ) until
  ;

8 value (tilew)
8 value (tileh)
: draw-tilemap ( addr map-w cols rows -- )
   locals| rows cols map-w |
   gl-texture gl-enable

   glDisableClientState( GL_COLOR_ARRAY )
   glDisableClientState( GL_NORMAL_ARRAY )

   unbind-vbo
   glTexCoordPointer( 2 GL_SHORT 0 tile-tcoords )
   glEnableClientState( GL_TEXTURE_COORD_ARRAY )

   vbo @ bind-vbo
   \ glVertexPointer( 2 GL_FLOAT 0 0 )
   glVertexPointer( 2 GL_SHORT 0 0 )
   glEnableClientState( GL_VERTEX_ARRAY )

   push-modelview
   glTranslatef( pen.@ 2s>f 0e )
   (tilew) s>f (tileh) s>f 1e glScalef
   rows 0 do  ( addr )
      dup
         tile-tcoords a!  cols 0 do   w@+  parse-tile  loop
      drop  map-w 2* +
      glDrawArrays( GL_QUADS  0  cols 4 * )
      modelview matrix glTranslatef( 0e 1e 0e )
   loop    drop
   pop-modelview ;

: tilemap-tile-size  ( w h -- )
   to (tileh) to (tilew) ;
